COMMENT ⊗   VALID 00004 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	see GRAPH.LSP for graph search apllications of all types
C00003 00003	Depthfirst search functions
C00005 00004	 breadth first search functions
C00008 ENDMK
C⊗;
;;;see GRAPH.LSP for graph search apllications of all types
;;;see INSANI.LSP INSANB.LSP for insanity game application of SEARCH
;;;see CSGREC for context sensitive grammar recognizer use of BSEARCH


(DEFPROP SEARCH '(
	SEARCH
	SEARCHLIS
	ALLSOL1
	ALLSOL
	ALLSOLA
	ALLSOLB
	DEPTHFIRST
	DEPTHFIRST2
	BSEARCH
	BS
	BSL
	BREADTHFIRST
	BREADTHACROSS
	BACKUP
)SEARCHFNS)

;;;Depthfirst search functions



(DEFUN SEARCH (P) (COND ((LOSE P) 'LOSE) ((TER P) P) (T (SEARCHLIS (SUCCESSORS P)))))

(DEFUN SEARCHLIS (U) (COND ((NULL U) 'LOSE) (T ((LAMBDA (X) (COND ((EQ X 'LOSE)
(SEARCHLIS (CDR U))) (T X))) (SEARCH (CAR U))))))

(DEFUN ALLSOL1 (P) (COND ((LOSE P) NIL)
		((TER P) (LIST P))
		(T (MAPAPP (FUNCTION ALLSOL1) (SUCCESSORS P)))))

(DEFUN ALLSOL (P) (ALLSOLA P NIL))

(DEFUN ALLSOLA (P FOUND) (COND
	((LOSE P) FOUND)
	((TER P) (CONS P FOUND))
	(T (ALLSOLB (SUCCESSORS P) FOUND))))

(DEFUN ALLSOLB (U FOUND) (COND
	((NULL U) FOUND)
	(T (ALLSOLB (CDR U) (ALLSOLA (CAR U) FOUND)))))

;;;DEPTHFIRST with cutoff level  returns list of positions leading to winning
;;;position

(DEFUN DEPTHFIRST (S N)
  (COND ((LESSP N 0) NIL)
	((ISWIN S) (NCONS N))
	(T (DEPTHFIRST2 (SUCCESSORS S) N)))) 

(DEFUN DEPTHFIRST2 (Z N)
  (COND ((NULL Z) NIL)
	(T ((LAMBDA (Q) 
	      (COND ((NULL Q) (DEPTHFIRST2 (CDR Z) N))
		    (T (CONS (CAR Z) Q)))) 
            (DEPTHFIRST (CAR Z) (SUB1 N)) )) ))

;;; breadth first search functions

;;;BSEARCH uses simple fifo queue to keep track of what to do next.
(DEFUN BSEARCH (P0) (BS P0 NIL))

(DEFUN BS (P QU) 
  (COND ((ISWIN P) P) 
	((LOSING P) (BSL QU))
	(T (BSL (APPEND QU (SUCCESSORS P)))) ))

(DEFUN BSL (QU) (COND ((NULL QU) 'YOU_LOSE) (T (BS (CAR QU) (CDR QU))) ))


;;;Positions are atomic, path from to to current position is obtained
;;;	by chaining back via "daddy" property.  

(DEFUN BREADTHFIRST (S)
  (PROG (A ANS Z ZNOW ZNEXT)
	(COND ((ISWIN S) (RETURN (NCONS S))))
	(SETQ A S)
	(SETQ ZNOW (SETQ ZNEXT NIL))
L	(SETQ Z (SUCCESSORS A))
        (SETQ ANS (BREADTHACROSS Z A))
	(COND (ANS (RETURN ANS)))
	(SETQ ZNEXT (APPEND ZNEXT Z))
	(COND ((NULL ZNOW) (SETQ ZNOW ZNEXT) (SETQ ZNEXT NIL)))
	(COND ((NULL ZNOW)(RETURN NIL)))
	(SETQ A (CAR ZNOW))
	(SETQ ZNOW (CDR ZNOW))
	(GO L)))

(DEFUN BREADTHACROSS (Z DAD)
  (PROG (A ZZ)
	(SETQ ZZ Z)
    ACROSS
	(COND ((NULL ZZ) (RETURN NIL)) )
        (SETQ A (CAR ZZ))
	(OR (GET A (QUOTE DADDY)) (PUTPROP A DAD (QUOTE DADDY)))
	(COND ((ISWIN A) (RETURN (BACKUP A))) )
	(SETQ ZZ (CDR ZZ))
	(GO ACROSS) ))

(DEFUN BACKUP (Z)
  (PROG (PATH ZZ)
	(SETQ PATH (NCONS Z))
	(SETQ ZZ (GET Z (QUOTE DADDY)))
    BACK
	(COND ((NULL ZZ) (RETURN PATH)))
	(SETQ PATH (CONS ZZ PATH))
	(SETQ ZZ (GET ZZ (QUOTE DADDY)))
	(GO BACK) ))